PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/ctl3d_p.exe/CTL3D.PAS

Pascal/Delphi Source File | 1993-03-18 | 26.0 KB | 947 lines

Unit Ctl3D;

{****************************************************************************}
{                                                                            }
{ Unit:    CTL3D                                                             }
{ Version: 1.0                                                               }
{ Source:  Borland Pascal 7.0                                                }
{ Author:  Steve Hamer-Moss, CoCo Systems Ltd.                               }
{ Date:    February 1993                                                     }
{                                                                            }
{ Purpose:                                                                   }
{   BP7 interface unit for Microsoft's CTL3D dynamic link library. Allows    }
{   BP7 applications to use Microsoft-standard 3D dialog boxes and controls, }
{   even in parallel with BWCC (e.g., for use with common dialogs).          }
{                                                                            }
{****************************************************************************}

{$C MOVEABLE PRELOAD DISCARDABLE}

Interface

Uses

   CommDlg,
   ODialogs,
   OWindows,
   WinDOS,
   WinProcs,
    WinTypes;

Const

                                                   {Messages sent by CTL3D...}
    wm_DlgBorder                =    wm_User + 3567;
   wm_DlgSubclass                =    wm_User + 3568;

Type

   T3dApplication                =
   object(TApplication)                        {Main Application object}
      Public
      Destructor Done; Virtual;
       Constructor Init (AName : PChar; Auto31, Borders3D, CommDlgs3D : Boolean);
   end;

    T3dDialog                    =
    object(TDialog)                            {Main dialog object}
      Public
      Procedure WMCtlColor (var Msg : TMessage); virtual wm_First + wm_CtlColor;
      Procedure WMDlgBorder (var Msg : TMessage); virtual wm_First + wm_DlgBorder;
      Procedure WMInitDialog (var Msg : TMessage); virtual wm_First + wm_InitDialog;
      Procedure WMNCActivate (var Msg : TMessage); virtual wm_First + wm_NCActivate;
      Procedure WMNCPaint (var Msg : TMessage); virtual wm_First + wm_NCPaint;
      Procedure WMSetText (var Msg : TMessage); virtual wm_First + wm_SetText;
   end;

   T3dMDIWindow                =
   object(TMDIWindow)                        {Main MDI window object}
        Procedure WMSysColorChange (var Msg : TMessage); virtual wm_First + wm_SysColorChange;
   end;

   T3dWindow                    =                {Main window object}
   object(TWindow)
        Procedure WMSysColorChange (var Msg : TMessage); virtual wm_First + wm_SysColorChange;
   end;

                                                    {Replacement common dialog functions ...}
Function ChooseColor3D (var CC : TChooseColor) : Bool;
Function ChooseFont3D (var CF : TChooseFont) : Bool;
Function FindText3D (var FR : TFindReplace) : HWnd;
Function GetOpenFilename3D (var OpenFile : TOpenFileName) : Bool;
Function GetSaveFilename3D (var OpenFile : TOpenFileName) : Bool;
Function PrintDlg3D (var PD : TPrintDlg) : Bool;
Function ReplaceText3D (var FR : TFindReplace) : HWnd;

Function Ctl3dIsEnabled : Boolean;

Implementation

Const

    dwl_MsgResult                =    0;
    hInstance_Error            =    THandle(32);
    sem_NoOpenFileErrorBox    =    $8000;

    Base_Version                =    $0009;

Const

   Ctl3dDLLName                =    'CTL3D.DLL';

    Ctl3D_Buttons                =    $0001;
    Ctl3D_Listboxes            =    $0002;
    Ctl3D_Edits                    =    $0004;
    Ctl3D_Combos                =    $0008;
    Ctl3D_StaticTexts            =    $0010;
    Ctl3D_StaticFrames        =    $0020;
    Ctl3D_All                    =    $FFFF;

   Ctl3D_Border                =    1;
   Ctl3D_NoBorder                =    0;
   Ctl3D_NoSubclass            =    0;
   Ctl3D_Subclass                =    1;

                                                   {Names of CTL3D exported functions ...}
    Ctl3dAutoSubClassName    =    'CTL3DAUTOSUBCLASS';
    Ctl3dColorChangeName        =    'CTL3DCOLORCHANGE';
    Ctl3dCtlColorExName        =    'CTL3DCTLCOLOREX';
    Ctl3dEnabledName            =    'CTL3DENABLED';
    Ctl3dDlgFramePaintName    =    'CTL3DDLGFRAMEPAINT';
    Ctl3dGetVerName            =    'CTL3DGETVER';
    Ctl3dRegisterName            =    'CTL3DREGISTER';
    Ctl3dSubclassDlgName        =    'CTL3DSUBCLASSDLG';
    Ctl3dSubclassCtlName        =    'CTL3DSUBCLASSCTL';
    Ctl3dUnregisterName        =    'CTL3DUNREGISTER';

Type

                                                   {CTL3D exported function templates ...}
    TCtl3dAutoSubclass        =    Function (Instance : THandle) : Bool;
    TCtl3dColorChange            =    Function : Bool;
    TCtl3dCtlColorEx            =    Function (Message, wParam : Word; lParam : LongInt) : HBrush;
    TCtl3dEnabled                =    Function : Bool;
   TCtl3dDlgFramePaint        =    Function (HWindow : HWnd; Message, wParam : Word; lParam : LongInt) : LongInt;
    TCtl3dGetVer                =    Function : Word;
    TCtl3dRegister                =    Function (Instance : THandle): Bool;
    TCtl3dSubclassCtl            =    Function (HWindow : HWnd) : Bool;
    TCtl3dSubclassDlg            =    Function (HWindow : HWnd; GrBits : Word) : Bool;
    TCtl3dUnregister            =    Function (Instance : THandle): Bool;

    TCommDlgHook                =    function (Wnd: HWnd; Msg, wParam: Word; lParam: LongInt): Word;

Var

                                                   {Variables to hold addresses of CTL3D
                                                     exported functions ...}
    Ctl3dAutoSubclass            :    TCtl3dAutoSubclass;
    Ctl3dColorChange            :    TCtl3dColorChange;
    Ctl3dCtlColorEx            :    TCtl3dCtlColorEx;
    Ctl3dEnabled                :    TCtl3dEnabled;
   Ctl3dDlgFramePaint        :    TCtl3dDlgFramePaint;
    Ctl3dGetVer                    :    TCtl3dGetVer;
    Ctl3dRegister                :    TCtl3dRegister;
    Ctl3dSubclassDlg            :    TCtl3dSubclassDlg;
    Ctl3dSubclassCtl            :    TCtl3dSubclassCtl;
    Ctl3dUnregister            :    TCtl3dUnregister;

Const

   A31                            :    Boolean = True;        {True if Auto-subclassing}
   B3D                            :    Boolean = False;        {True if using 3D borders}
   CD3D                            :    Boolean = True;        {True if using 3D common dialogs}
   Ctl3dHandle                    :    THandle = 0;            {Handle to CTL3D DLL}
   UseCtl3d                        :    Boolean = False;        {True if using 3D controls}

Var

   UserHookProc                :    TCommDlgHook;            {Address of user's hook proc,
                                                                     if any, for common dialogs}
    WinVersion                    :    Word;                        {Windows version number}
    Win30                            :    Boolean;                    {True if Windows 3.0}

{* ------------------------ Ctl3dIsEnabled ------------------------- *}

Function Ctl3dIsEnabled : Boolean;
{
    Returns True if unit has enabled use of 3D controls
}
begin
    Ctl3dIsEnabled := UseCtl3d
end;

{* -------------------------- HookProc3D --------------------------- *}

Function HookProc3D (HWindow : HWnd; Msg, wParam : Word; lParam : LongInt) : Word; Export;
{
    Common hook procedure for common dialogs. Implements 3D controls for all
   common dialogs when used via the replacement common dialog functions
   contained in this unit.

   If the user has also defined a hook procedure for use with the current
   common dialog function call, its address is now in the unit variable
    UserHookProc. The user hook is then called before this procedure does
    its 3D stuff.
}
Type

    TIntPtr                =    ^Integer;

begin

                                                   {Call user hook procedure first}
   if Assigned(@UserHookProc)
   then
       HookProc3D := UserHookProc(HWindow,Msg,wParam,lParam)
   else
       HookProc3D := 0;

   if UseCtl3D and CD3D
   then                                            {Now do the 3D stuff ...}
        Case Msg of

            wm_InitDialog:
                if Assigned(@Ctl3dSubclassDlg)
                then                                {Initialise: Subclass the common dialog
                                                     via CTL3D}
                    Ctl3dSubclassDlg(HWindow,Ctl3D_All);

         wm_CtlColor:
             if Assigned(@Ctl3dCtlColorEx)
            then                                {Colour setup: tell CTL3D to do graying}
                HookProc3D := Ctl3dCtlColorEx(Msg,wParam,lParam);

         wm_DlgBorder:
             if B3D
                then                                {Border: tell CTL3D to paint a 3D border}
                    TIntPtr(lParam)^ := Ctl3D_Border
            else                                {Border: tell CTL3D to use a modal border}
                    TIntPtr(lParam)^ := Ctl3D_NoBorder;

         wm_NCActivate,
         wm_NCPaint,
         wm_SetText:
             if B3D and Assigned(@Ctl3dDlgFramePaint)
            then
            begin                                {This will ensure CTL3D paints the controls
                                                     correctly ...}

               SetWindowLong(HWindow,dwl_MsgResult,
                                      Ctl3dDlgFramePaint(HWindow,Msg,wParam,lParam));
                    HookProc3D := 1

            end

      end

end;

{* ------------------------- ChooseColor3D -------------------------- *}

Function ChooseColor3D (var CC : TChooseColor) : Bool;
{
    Replacement for common dialog function ChooseColor. Sets up local
   hook procedure for 3D painting (saving address of any user hook proc
    into UserHookProc) and then calls ChooseColor.
}
begin

   if not (UseCtl3D and CD3D)
   then
       ChooseColor3D := ChooseColor(CC)
    else
   begin

       if ((CC.Flags and cc_EnableHook) = cc_EnableHook)
       then
            UserHookProc := CC.lpfnHook
       else
       begin

         UserHookProc := nil;
            CC.Flags := CC.Flags or cc_EnableHook

       end;

       TFarProc(@CC.lpfnHook) := MakeProcInstance(TFarProc(@HookProc3D),hInstance);
        ChooseColor3D := ChooseColor(CC);
       FreeProcInstance(TFarProc(@CC.lpfnHook))

   end

end;

{* -------------------------- ChooseFont3D -------------------------- *}

Function ChooseFont3D (var CF : TChooseFont) : Bool;
{
    Replacement for common dialog function ChooseFont. Sets up local
   hook procedure for 3D painting (saving address of any user hook proc
    into UserHookProc) and then calls ChooseFont.
}
begin

   if not (UseCtl3D and CD3D)
   then
       ChooseFont3D := ChooseFont(CF)
    else
   begin

        if    ((CF.Flags and cf_EnableHook) = cf_EnableHook)
       then
            UserHookProc := CF.lpfnHook
       else
       begin

         UserHookProc := nil;
            CF.Flags := CF.Flags or cf_EnableHook

       end;

       TFarProc(@CF.lpfnHook) := MakeProcInstance(TFarProc(@HookProc3D),hInstance);
       ChooseFont3D := ChooseFont(CF);
       FreeProcInstance(TFarProc(@CF.lpfnHook))

   end

end;

{* --------------------------- FindText3D --------------------------- *}

Function FindText3D (var FR : TFindReplace) : HWnd;
{
    Replacement for common dialog function FindText. Sets up local
   hook procedure for 3D painting (saving address of any user hook proc
    into UserHookProc) and then calls FindText.
}
begin

   if not (UseCtl3D and CD3D)
   then
       FindText3D := FindText(FR)
    else
   begin

        if ((FR.Flags and fr_EnableHook) = fr_EnableHook)
       then
            UserHookProc := FR.lpfnHook
       else
       begin

         UserHookProc := nil;
            FR.Flags := FR.Flags or fr_EnableHook

       end;

       TFarProc(@FR.lpfnHook) := MakeProcInstance(TFarProc(@HookProc3D),hInstance);
       FindText3D := FindText(FR);
       FreeProcInstance(TFarProc(@FR.lpfnHook))

   end

end;

{* ----------------------- GetOpenFilename3D ------------------------ *}

Function GetOpenFilename3D (var OpenFile : TOpenFileName) : Bool;
{
    Replacement for common dialog function GetOpenFileName. Sets up local
   hook procedure for 3D painting (saving address of any user hook proc
    into UserHookProc) and then calls GetOpenFileName.
}
begin

   if not (UseCtl3D and CD3D)
   then
       GetOpenFileName3D := GetOpenFileName(OpenFile)
    else
   begin

        if ((OpenFile.Flags and ofn_EnableHook) = ofn_EnableHook)
       then
            UserHookProc := OpenFile.lpfnHook
       else
       begin

         UserHookProc := nil;
            OpenFile.Flags := OpenFile.Flags or ofn_EnableHook

       end;

       TFarProc(@OpenFile.lpfnHook) := MakeProcInstance(TFarProc(@HookProc3D),hInstance);
       GetOpenFileName3D := GetOpenFileName(OpenFile);
       FreeProcInstance(TFarProc(@OpenFile.lpfnHook))

   end

end;

{* ----------------------- GetSaveFilename3D ----------------------- *}

Function GetSaveFilename3D (var OpenFile : TOpenFileName) : Bool;
{
    Replacement for common dialog function GetSaveFileName. Sets up local
   hook procedure for 3D painting (saving address of any user hook proc
    into UserHookProc) and then calls GetSaveFileName.
}
begin

   if not (UseCtl3D and CD3D)
   then
       GetSaveFileName3D := GetSaveFileName(OpenFile)
    else
   begin

        if ((OpenFile.Flags and ofn_EnableHook) = ofn_EnableHook)
       then
            UserHookProc := OpenFile.lpfnHook
       else
       begin

         UserHookProc := nil;
            OpenFile.Flags := OpenFile.Flags or ofn_EnableHook

       end;

       TFarProc(@OpenFile.lpfnHook) := MakeProcInstance(TFarProc(@HookProc3D),hInstance);
       GetSaveFileName3D := GetOpenFileName(OpenFile);
       FreeProcInstance(TFarProc(@OpenFile.lpfnHook))

   end

end;

{* --------------------------- PrintDlg3d -------------------------- *}

Function PrintDlg3D (var PD : TPrintDlg) : Bool;
{
    Replacement for common dialog function PrintDlg. Sets up local
   hook procedure for 3D painting (saving address of any user hook proc
    into UserHookProc) and then calls PrintDlg.
}
begin

   if not (UseCtl3D and CD3D)
   then
       PrintDlg3D := PrintDlg(PD)
    else
   begin

        if ((PD.Flags and pd_EnablePrintHook) = pd_EnablePrintHook)
       then
            UserHookProc := TCommDlgHook(PD.lpfnPrintHook)
       else
       begin

         UserHookProc := nil;
            PD.Flags := PD.Flags or pd_EnablePrintHook

       end;

        if ((PD.Flags and pd_EnableSetupHook) = pd_EnableSetupHook)
       then
            UserHookProc := TCommDlgHook(PD.lpfnSetupHook)
       else
       begin

         UserHookProc := nil;
            PD.Flags := PD.Flags or pd_EnableSetupHook

       end;

       TFarProc(@PD.lpfnPrintHook) := MakeProcInstance(TFarProc(@HookProc3D),hInstance);
       PD.lpfnSetupHook := PD.lpfnPrintHook;
       PrintDlg3D := PrintDlg(PD);
       FreeProcInstance(TFarProc(@PD.lpfnPrintHook))

   end

end;

{* ------------------------- ReplaceText3d ------------------------- *}

Function ReplaceText3D (var FR : TFindReplace) : HWnd;
{
    Replacement for common dialog function ReplaceText. Sets up local
   hook procedure for 3D painting (saving address of any user hook proc
    into UserHookProc) and then calls ReplaceText.
}
begin

   if not (UseCtl3D and CD3D)
   then
       ReplaceText3D := ReplaceText(FR)
    else
   begin

        if ((FR.Flags and fr_EnableHook) = fr_EnableHook)
       then
            UserHookProc := FR.lpfnHook
       else
       begin

         UserHookProc := nil;
            FR.Flags := FR.Flags or fr_EnableHook

       end;

       TFarProc(@FR.lpfnHook) := MakeProcInstance(TFarProc(@HookProc3D),hInstance);
       ReplaceText3D := ReplaceText(FR);
       FreeProcInstance(TFarProc(@FR.lpfnHook))

   end

end;

{* ------------------------ CloseDownCtl3d ------------------------- *}

Procedure CloseDownCtl3d;
{
    Application cleanup code called from T3DApplication.Done. Frees the
   CTL3D library for this app.
}
begin

    if Ctl3dHandle >= hInstance_Error
    then
        FreeLibrary(Ctl3dHandle);

      UseCtl3d := False;
    @Ctl3dAutoSubclass := nil;
    @Ctl3dColorChange := nil;
    @Ctl3dCtlColorEx := nil;
    @Ctl3dEnabled := nil;
   @Ctl3dDlgFramePaint := nil;
    @Ctl3dGetVer := nil;
    @Ctl3dRegister := nil;
    @Ctl3dSubclassDlg := nil;
    @Ctl3dSubclassCtl := nil;
    @Ctl3dUnregister := nil

end;

{* -------------------------- DLLExists ---------------------------- *}

Function DLLExists (FN : PChar; AName : PChar) : Boolean;
{
    General routine that looks for a DLL file. Used only when running
    under Windows 3.0 (to prevent the 'Cannot find ...' system modal
    dialog box that occurs under Win 3.0 if the DLL is not present when
    calling LoadLibrary).

   Looks for named DLL in the following order:

   (1) The current directory,
   (2) The windows directory,
   (3) The windows system directory,
   (4) Anywhere in the DOS Path.

   Returns true if found.
}
const

    TempLen            =    255;

var

   Dest                :    array[0..fsPathName] of char;
   Temp                :    array[0..TempLen] of char;
   TExt                :    array[0..fsExtension] of char;
    TName                :    array[0..fsFileName] of char;

begin

   DLLExists := False;
   Temp[0] := #0;

   FileSearch(Dest,FN,Temp);

   if Dest[0] <> #0
   then
       DLLExists := True
   else
   begin

       GetWindowsDirectory(Temp,TempLen);
       FileSearch(Dest,FN,Temp);

       if Dest[0] <> #0
       then
           DLLExists := True
      else
      begin

           GetSystemDirectory(Temp,TempLen);
           FileSearch(Dest,FN,Temp);

           if Dest[0] <> #0
           then
               DLLExists := True
         else
         begin

               GetModuleFileName(GetModuleHandle(AName),Temp,SizeOf(Temp));
                FileSplit(Temp,Temp,TName,TExt);
                FileSearch(Dest,FN,Temp);

               if Dest[0] <> #0
               then
                   DLLExists := True
             else
            begin

                   FileSearch(Dest,FN,GetEnvVar('PATH'));

                   if Dest[0] <> #0
                   then
                       DLLExists := True

            end

            end

        end

   end

end;

{* -------------------------- SetupCtl3d --------------------------- *}

Function SetupCtl3d (AName : PChar; Auto31, Borders3D, CommDlgs3D : Boolean) : Boolean;
{
    Initialises this unit for T3DApplication.Init.
}
begin

   SetupCtl3d := True;                        {Assume all will be OK}

   if UseCtl3d
   then                                            {Already set up! Finish now}
       Exit;

    if Win30
   then
   begin                                            {Running under Win 3.0: look for CTL3D.DLL
                                                     without causing user error}

        if DLLExists(Ctl3dDLLName,AName)
        then
            Ctl3dHandle := LoadLibrary(Ctl3dDLLName)
      else
          Ctl3dHandle := 0

   end
   else
   begin                                            {Running under Win 3.1: look for CTL3D.DLL
                                                     without error message}

        SetErrorMode(sem_NoOpenFileErrorBox);
       Ctl3dHandle := LoadLibrary(Ctl3dDLLName);
        SetErrorMode(0)

   end;

   if Ctl3dHandle >= hInstance_Error
   then
   begin                                            {Found CTL3D... }

                                                  {get addresses of CTL3D exported functions}
       @Ctl3dAutoSubclass := GetProcAddress(Ctl3dHandle,Ctl3dAutoSubClassName);
       @Ctl3dColorChange := GetProcAddress(Ctl3dHandle,Ctl3dColorChangeName);
       @Ctl3dCtlColorEx := GetProcAddress(Ctl3dHandle,Ctl3dCtlColorExName);
       @Ctl3dEnabled := GetProcAddress(Ctl3dHandle,Ctl3dEnabledName);
      @Ctl3dDlgFramePaint := GetProcAddress(Ctl3dHandle,Ctl3dDlgFramePaintName);
       @Ctl3dGetVer := GetProcAddress(Ctl3dHandle,Ctl3dGetVerName);
       @Ctl3dRegister := GetProcAddress(Ctl3dHandle,Ctl3dRegisterName);
       @Ctl3dSubclassDlg := GetProcAddress(Ctl3dHandle,Ctl3dSubclassDlgName);
       @Ctl3dSubclassCtl := GetProcAddress(Ctl3dHandle,Ctl3dSubclassCtlName);
       @Ctl3dUnregister := GetProcAddress(Ctl3dHandle,Ctl3dUnregisterName);

                                                  {Register this app instance with DLL}
       UseCtl3D := Ctl3dRegister(hInstance);

      if UseCtl3D
        then                                        {Registration successful - ensure we have
                                                     a recent enough version of CTL3D, and
                                                     calling app wants to use 3D controls}
          UseCtl3d := Ctl3dEnabled and (Ctl3dGetVer >= Base_Version);

      if not UseCtl3D
      then                                        {Not all conditions met - tidy up}
          CloseDownCtl3d
      else
      begin

         A31 := Auto31;                        {Save Auto-subclass state}
         B3D := Borders3D;                    {Save 3D borders state}
         CD3D := CommDlgs3D;                {Save 3D common dialogs state}

          if (not Win30) and A31
         then                                    {CTL3D does not support auto-subclassing
                                                     for Windows 3.0}
             Ctl3dAutoSubclass(hInstance)

      end

   end;

   SetupCtl3d := UseCtl3d                    {Return True if initialised OK}

end;

{****************************************************************************}
{*                                                                          *}
{* Object:   T3dApplication                                                 *}
{*                                                                          *}
{*                                                                          *}
{* Replacement object for TApplication. Contains replacement Init and Done  *}
{* methods to ensure proper set-up/close-down of 3D interface code.         *}
{*                                                                          *}
{****************************************************************************}

{* ------------------------- T3dApplication.Done -------------------------- *}

Destructor T3dApplication.Done;
{
    Deregisters the application instance from CTL3D DLL and tidies up.
}
begin

   if UseCtl3d
   then
   begin

      Ctl3dUnregister(hInstance);
       CloseDownCtl3d

   end;

    inherited Done

end;

{* ------------------------- T3dApplication.Init -------------------------- *}

Constructor T3dApplication.Init (AName : PChar; Auto31, Borders3D, CommDlgs3D : Boolean);
{
    Takes care of application-level setup for use of 3D dialogs. Parameters are as
   follows:

   AName:        Application name (as for TApplication.Init)
   Auto31:     True if CTL3D is to auto-subclass dialogs under Windows 3.1
   Borders3D:    True to use 3D bordres, False to use modal dialog borders
   CommDlgs3D: True if common dialogs are to be 3D (if Auto31 is True, common
                    dialogs are ALWAYS* 3D)
}
begin

    inherited Init(AName);
   SetupCtl3d(AName,Auto31,Borders3D,CommDlgs3D)

end;

{****************************************************************************}
{*                                                                          *}
{* Object:   T3dDialog                                                      *}
{*                                                                          *}
{* Replacement object for TDialog. Controls CTL3D subclassing of individual *}
{* dialogs, and setup of the correct type of dialog border.                 *}
{*                                                                          *}
{****************************************************************************}

{* ------------------------ T3dDialog.WMCtlColor ------------------------- *}

Procedure T3dDialog.WMCtlColor (var Msg : TMessage);
{
    Ensures proper color setup for 3D dialog.
}
begin

    if (not BWCCClassNames) and UseCtl3d and Assigned(@Ctl3dCtlColorEx)
   then
       With Msg
      do
          Result := Ctl3dCtlColorEx(Message,wParam,lParam)

end;

{* ------------------------ T3dDialog.WMDlgBorder ------------------------ *}

Procedure T3dDialog.WMDlgBorder (var Msg : TMessage);
{
    Controls use of 3D border.
}
Type

    TIntPtr                =    ^Integer;

begin

    if (not BWCCClassNames) and UseCtl3d
   then
   begin

        if B3D
      then
          TIntPtr(Msg.lParam)^ := Ctl3D_Border
      else
          TIntPtr(Msg.lParam)^ := Ctl3D_NoBorder

   end

end;

{* ------------------------ T3dDialog.WMInitDialog ------------------------ *}

Procedure T3dDialog.WMInitDialog (var Msg : TMessage);
{
    Causes CTL3D to subclass dialog.
}
begin

   if (not BWCCClassNames) and UseCtl3d
   then
       Ctl3dSubclassDlg(hWindow,Ctl3D_All);

    inherited WMInitDialog(Msg)

end;

{* ------------------------ T3dDialog.WMNCActivate ------------------------ *}

Procedure T3dDialog.WMNCActivate (var Msg : TMessage);
{
   Ensures proper frame painting of 3D dialogs on mouse activation.
}
begin

   if (not BWCCClassNames) and UseCtl3d and B3D and IsModal and
        Assigned(@Ctl3dDlgFramePaint)
   then
        With Msg
       do
      begin

            SetWindowLong(HWindow,dwl_MsgResult,
                              Ctl3dDlgFramePaint(HWindow,Message,wParam,lParam));
            Result := 1

      end
   else
       DefWndProc(Msg)

end;

{* ------------------------- T3dDialog.WMNCPaint -------------------------- *}

Procedure T3dDialog.WMNCPaint (var Msg : TMessage);
{
    ... again, part of proper 3D painting
}
begin

   if (not BWCCClassNames) and UseCtl3d and B3D and IsModal and
        Assigned(@Ctl3dDlgFramePaint)
   then
        With Msg
       do
      begin

            SetWindowLong(HWindow,dwl_MsgResult,
                              Ctl3dDlgFramePaint(HWindow,Message,wParam,lParam));
            Result := 1

      end
   else
       DefWndProc(Msg)

end;

{* ------------------------- T3dDialog.WMSetText -------------------------- *}

Procedure T3dDialog.WMSetText (var Msg : TMessage);
{
{
    ... again, part of proper 3D painting
}
}
begin

   if (not BWCCClassNames) and UseCtl3d and B3D and IsModal and
        Assigned(@Ctl3dDlgFramePaint)
   then
        With Msg
       do
      begin

            SetWindowLong(HWindow,dwl_MsgResult,
                              Ctl3dDlgFramePaint(HWindow,Message,wParam,lParam));
            Result := 1

      end
   else
       DefWndProc(Msg)

end;

{****************************************************************************}
{*                                                                          *}
{* Object:   T3dMDIWindow                                                   *}
{*                                                                          *}
{* Replacement object for TMDIWindow. Processes wm_SysColorChange to ensure *}
{* CTL3D is kept up to date on desktop color scheme.                        *}
{*                                                                          *}
{****************************************************************************}

{* -------------------- T3dMDIWindow.WMSysColorChange --------------------- *}

Procedure T3dMDIWindow.WMSysColorChange (var Msg : TMessage);
{
    Tell CTL3D of the new desktop color scheme
}
begin

   if UseCtl3d
   then
       Ctl3dColorChange

end;

{****************************************************************************}
{*                                                                          *}
{* Object:   T3dWindow                                                      *}
{*                                                                          *}
{* Replacement object for TWindow. Processes wm_SysColorChange to ensure    *}
{* CTL3D is kept up to date on desktop color scheme.                        *}
{*                                                                          *}
{****************************************************************************}

{* ---------------------- T3dWindow.WMSysColorChange ---------------------- *}

Procedure T3dWindow.WMSysColorChange (var Msg : TMessage);
{
    Tell CTL3D of the new desktop color scheme
}
begin

   if UseCtl3d
   then
       Ctl3dColorChange

end;

{****************************************************************************}
{*                                                                          *}
{* Unit initialisation. Get Windows version number, and note whether we are *}
{* running under Windows 3.0.                                               *}
{*                                                                          *}
{****************************************************************************}

begin

   WinVersion := GetVersion;
    Win30 := (lo(WinVersion) = 3) and (hi(WinVersion) < 10)

end.